home *** CD-ROM | disk | FTP | other *** search
/ Workbench Design / WB Collection.iso / workbench werkzeuge / requester / filerequester / keypatch.mod < prev    next >
Text File  |  1996-04-07  |  5KB  |  225 lines
  1. MODULE KeyPatch;
  2.  
  3. (*
  4.  
  5.    KeyPatch 1.0    (13.10.1993)
  6.  
  7.    by Carsten Orthbandt
  8.  
  9.    Compiler: Amiga Oberon 3.0
  10.  
  11. *)
  12.  
  13.  
  14.  
  15.  
  16. IMPORT e:Exec,
  17.        es:ExecSupport,
  18.        cx:Commodities,
  19.        conv:Conversions,
  20.        y:SYSTEM,
  21.        str:Strings,
  22.        d:Dos,
  23.        fr:FileReq,
  24.        wb:Workbench,
  25.        ol:OberonLib,
  26.        I: Intuition,
  27.        ie:InputEvent,
  28.        u: Utility,
  29.        ic:Icon;
  30.  
  31. TYPE   MyStr=ARRAY 254 OF CHAR;
  32.  
  33. VAR
  34.      PopKey:ARRAY 100 OF CHAR;
  35.      MyBrk :cx.CxObjPtr;
  36.      MyFil :cx.CxObjPtr;
  37.      MySnd :cx.CxObjPtr;
  38.      MyTrs :cx.CxObjPtr;
  39.      NwBrk :cx.NewBroker;
  40.      MsPrt :e.MsgPortPtr;
  41.      Quit  :BOOLEAN;
  42.      Shut  :BOOLEAN;
  43.      Err   :LONGINT;
  44.      eMsg  :e.APTR;
  45.      Msg   :cx.CxMsgPtr;
  46.      MsTp  :LONGSET;
  47.      MsId  :LONGINT;
  48.      CxPri :LONGINT;
  49.      CxKey :ARRAY 254 OF CHAR;
  50.      strn:MyStr;
  51.      Signal:LONGSET;
  52.  
  53. PROCEDURE GetToolTypes;
  54. VAR This:d.ProcessPtr;
  55.     wbm:wb.WBStartupPtr;
  56.     sptr:e.STRPTR;
  57.     MyIcon:wb.DiskObjectPtr;
  58.     OCurrentDir:d.FileLockPtr;
  59. BEGIN;
  60. This:=y.VAL(d.ProcessPtr,ol.Me);
  61. CxPri:=0;CxKey:="shift control f";
  62. IF ol.wbStarted THEN
  63.  wbm:=ol.wbenchMsg;
  64.  OCurrentDir:=This.currentDir;
  65.  y.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
  66.  MyIcon := ic.GetDiskObject(wbm.argList[0].name^);
  67.  y.SETREG(0,d.CurrentDir(OCurrentDir));
  68.  IF MyIcon#NIL THEN
  69.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_PRIORITY");
  70.   IF sptr#NIL THEN IF conv.StringToInt(sptr^,CxPri) THEN END;END;
  71.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_POPKEY");
  72.   IF sptr#NIL THEN COPY(sptr^,CxKey);END;
  73.   ic.FreeDiskObject(MyIcon);
  74.  END;
  75. END;
  76. END GetToolTypes;
  77.  
  78. PROCEDURE Disable;
  79. BEGIN;
  80. IF cx.ActivateCxObj(MyBrk,0)#0 THEN END;
  81. END Disable;
  82.  
  83. PROCEDURE Enable;
  84. BEGIN;
  85. IF cx.ActivateCxObj(MyBrk,1)#0 THEN END;
  86. END Enable;
  87.  
  88. PROCEDURE Init():BOOLEAN;
  89. VAR ret:BOOLEAN;
  90. BEGIN;
  91. ret:=TRUE;
  92. Shut:=FALSE;
  93. IF ret THEN
  94. MsPrt:=e.CreateMsgPort();
  95. IF MsPrt=NIL THEN ret:=FALSE;END;
  96. IF ret THEN
  97. NwBrk.version:=cx.nbVersion;
  98. NwBrk.name:=y.ADR("FileRequest");
  99. NwBrk.title:=y.ADR("FileRequest 1.0 by HDS");
  100. NwBrk.descr:=y.ADR("FileRequester by shortcut");
  101. NwBrk.unique:=SET{0,1};
  102. NwBrk.flags:=SET{};
  103. NwBrk.pri:=SHORT(SHORT(CxPri));
  104. NwBrk.port:=MsPrt;
  105. NwBrk.reservedChannel:=0;
  106. MyBrk:=cx.CxBroker(NwBrk,Err);
  107. IF Err#0 THEN ret:=FALSE;END;
  108. IF ret THEN
  109. MyFil:=cx.CxFilter(y.ADR(CxKey));
  110. MySnd:=cx.CxSender(MsPrt,cx.cxmIEvent);
  111. MyTrs:=cx.CxTranslate(NIL);
  112. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  113. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  114. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  115. cx.AttachCxObj(MyBrk,MyFil);
  116. cx.AttachCxObj(MyFil,MySnd);
  117. cx.AttachCxObj(MyFil,MyTrs);
  118. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  119. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  120. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  121. IF cx.ActivateCxObj(MyBrk,1)#0 THEN ret:=FALSE;END;
  122. IF MyFil=NIL THEN ret:=FALSE;END;
  123. IF MySnd=NIL THEN ret:=FALSE;END;
  124. IF MyTrs=NIL THEN ret:=FALSE;END;
  125. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  126. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  127. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  128. END;END;END;
  129. RETURN (ret);
  130. END Init;
  131.  
  132. PROCEDURE ShutDown;
  133. BEGIN;
  134. IF MyBrk#NIL THEN cx.DeleteCxObjAll(MyBrk);
  135. REPEAT;UNTIL e.GetMsg(MsPrt)=NIL;END;
  136. IF MsPrt#NIL THEN
  137. e.DeleteMsgPort(MsPrt);END;
  138. END ShutDown;
  139.  
  140. PROCEDURE DoString(strg:MyStr);
  141. VAR n:INTEGER;
  142.    iv:ie.InputEventPtr;
  143. BEGIN;
  144. NEW(iv);
  145. FOR n:=0 TO SHORT(str.Length(strg)-1) DO
  146. IF cx.InvertKeyMap(ORD(strg[n]),iv,NIL) THEN
  147.  d.Delay(2);
  148.  cx.AddIEvents(iv);
  149. END;
  150. END;
  151. DISPOSE(iv);
  152. END DoString;
  153.  
  154. PROCEDURE CheckCx;
  155. VAR wnp:I.WindowPtr;
  156.     scr:I.ScreenPtr;
  157.     nwn:I.NewWindow;
  158.     awn:I.WindowPtr;
  159.     agd,agn:I.GadgetPtr;
  160.     arq:I.RequesterPtr;
  161. BEGIN;
  162. IF MsPrt#NIL THEN
  163. REPEAT;
  164. eMsg:=e.GetMsg(MsPrt);
  165. IF eMsg#NIL THEN
  166. Msg:=y.VAL(cx.CxMsgPtr,eMsg);
  167. MsTp:=cx.CxMsgType(Msg);
  168. MsId:=cx.CxMsgID(Msg);
  169. e.ReplyMsg(eMsg);
  170.  IF MsTp=LONGSET{cx.cxmIEvent} THEN
  171.   scr:=I.base.activeScreen;
  172.   awn:=I.base.activeWindow;
  173.   agd:=NIL;agn:=NIL;arq:=NIL;
  174.   IF awn.firstGadget#NIL THEN
  175.    agn:=awn.firstGadget;
  176.    WHILE agn#NIL DO
  177.     IF (I.selected IN agn.flags) AND((agn.gadgetType MOD 4)=0) THEN
  178.      agd:=agn;END;
  179.     agn:=agn.nextGadget;
  180.    END;
  181.   END;
  182.   IF awn.firstRequest#NIL THEN
  183.    arq:=awn.firstRequest;
  184.    agn:=arq.reqGadget;
  185.    WHILE agn#NIL DO
  186.     IF (I.selected IN agn.flags) AND((agn.gadgetType MOD 4)=0) THEN
  187.      agd:=agn;END;
  188.     agn:=agn.nextGadget;
  189.    END;
  190.   END;
  191.   nwn:=I.NewWindow(0,0,5,5,1,1,LONGSET{},LONGSET{},NIL,NIL,y.ADR(""),
  192.   NIL,NIL,5,5,30,30,I.customScreen);
  193.   nwn.screen:=scr;
  194.   wnp:=I.OpenWindowTags(nwn,u.done);
  195.   IF fr.FileReqWin("Open File",strn,wnp) THEN
  196.   IF awn#NIL THEN I.ActivateWindow(awn);
  197.    IF agd#NIL THEN IF I.ActivateGadget(agd^,awn,arq)THEN END;END;END;
  198.   DoString(strn);END;
  199.   I.CloseWindow(wnp);
  200.  END;
  201.  IF MsTp=LONGSET{cx.cxmCommand} THEN
  202.   IF MsId=cx.cmdDisable THEN Disable;END;
  203.   IF MsId=cx.cmdEnable THEN Enable;END;
  204.   IF MsId=cx.cmdKill THEN Quit:=TRUE;END;
  205.   IF MsId=cx.cmdUnique THEN Quit:=TRUE;END;
  206.  END;
  207. END;
  208. UNTIL eMsg=NIL;
  209. END;
  210. END CheckCx;
  211.  
  212. BEGIN;
  213. GetToolTypes;
  214. IF Init() THEN
  215. Enable;
  216. CheckCx;
  217. REPEAT;
  218. e.WaitPort(MsPrt);
  219. CheckCx;
  220. UNTIL Quit;
  221. END;
  222. ShutDown;
  223. END KeyPatch.
  224.  
  225.